perm filename MPRX.FAI[RST,LCS]1 blob sn#233043 filedate 1976-08-22 generic text, type T, neo UTF8
00100		TITLE MPRFAI
00200		ENTRY MPRFAI
00300		EXTERNAL DL,FRMT,.COMM.,XRN,ALF,STF,POSI,PTR,DPY,FONT,PLTR
00400		EXTERNAL PLOT,ALPHA,NOTWRT,METER,SLUR,NOTWRT,ROFF,RHORZ,RESET
00500		EXTERNAL ITMSUB,GETFI2,FASTI2,BMSTF,PLTSRT,TOOMCH,ENDIT,STAFF
00600		EXTERNAL KSIG,MAKNUM,CLEFS,UNKNWN,ILLEGL,CENTX,RUNTHR,PLTCMD
00700	;	IMPLICIT INTEGER(A-Q,S-Z)
00800	;	REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
00900	;	COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
01000	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01100	;					   ↓↓↓↓↓ V IS FOR READIN ONLY
01200	;	COMMON  /XRN/RN(3000),V(1000) /ALF/INP(72),ML
01300	;	1 /STF/RSTFAC(-3/4),RSTJ2  /POSI/STFF(-3/4),JJ2,POS
01400	;	1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01500	;	1/PLTR/PLT,RHT,DIS
01600	;	EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
01700	;	1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
01800	;	1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
01900	;	DATA IP/'P'/,FA1/'( A1)'/
02000	MPRFAI:	0
02100		SETZM ITMS#		;	ITMS=0
02200		SETZM TOTAL 		;	TOTAL=0
02300		MOVN [999.0]		;	RPLT=-999.
02400		MOVEM RPLT#		;  RPLT WILL BE FOR HEAVY STAFF LINES.
02500	;;MP23:	JSA 16,RESET		;23	TYPE 21
02600	;;	K#			;21	FORMAT(' RESET BOTTOM? '$)
02700	;;	MOVE K			;	ACCEPT FA1,K
02800	;;	CAMN [ASCII/A    /]		;	IF(K.EQ.'A')GO TO 124
02900	;;	JRST MP124		;	IF(K.EQ.'P')GO TO 123
03000			  ;TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
03100	;;	CAMN [ASCII/P    /]
03200	;;	JRST MP123
03300	;;	JRST MP24		;	GO TO 24
03400	;;MP123:	SETOM FONT		;123	JFONT=-1
03500	;;	JRST MP23		;GO TO 23
03600	;;MP124:	SETZM FONT		;124	JFONT=0
03700	;;	JRST MP23		;	GO TO 23
03800	;;MP24:	CAMN [ASCII/N    /]	;24	IF(K.EQ.'N')GO TO 22
03900	;;	JRST MP22	; 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
04000	  			; STARTING PEN POS.
04100				; 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
04200		MOVN [999.0]	;	TOP2=-999
04300		MOVEM TOP2
04400		SETZM RNOMOV#	;	RNOMOV=0
04500	MP22:	SETZM ALF	;22	I1=0
04600			;RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
04700	MP2:	MOVE [999.0]		;2	TOP=-999
04800		MOVNM DPY+1
04900		MOVEM DPY+2		;	BOT=999
05000	MP20:	SETZM PLTR		;20	PLT=0
05100		SETZM PLOTIT#		;	PLOTIT=0
05200		SETOM EDX#		;	EDX=-1
05300		MOVEI 1			;	M=1
05400		MOVEM PTR+=253
05500		JRST MP5504		;	GO TO 5504
05600	
05700	
05800	MP11:	JSA 16,NOTWRT		;11	CALL NOTWRT
05900	MP57:	SKIPGE PLTR		;57	IF(PLT)GO TO 6120
06000		JRST MP6120
06100		AOS PTR+=250		;	ITEM=ITEM+1
06200		SKIPGE EDX		;	IF(EDX.EQ.-1)GO TO 77
06300		JRST MP77
06400		MOVE PTR+=253		; M	IF(M.LT.I)GO TO 6120
06500		CAMGE PTR+=252		; I
06600		JRST MP6120
06700	MP77:	MOVN PLOTIT		;77	IF(PLOTIT.EQ.-2)GO TO 2311
06800		CAIN 2
06900		JRST MP2311
07000	MP5504:	MOVE [ASCII/P    /]	;5504	IF(I1.EQ.IP)GO TO 2311
07100		CAMN ALF
07200		JRST MP2311
07300		MOVEM ALF		;	I1=IP
07400		MOVE [ASCII/X    /]	;	INP(2)='X'
07500		MOVEM ALF+1
07600	MP311:	SETZM .COMM.+1		;311	JA=0
07700	MP2311:	SETZM NOSET
07800		JSA 16,PLTCMD		;2311	CALL PLTCMD
07900		NOSET#
08000		MOVN ALF+1		;	IF(INP(2).EQ.-1)GO TO 30
08100		CAIN 1
08200		JRST MP30		; **** END OF DATA ***
08300		SKIPN PLOTIT		;	IF(PLOTIT.EQ.0)GO TO 3005
08400		JRST MP3005
08500		MOVE [ASCII/P    /]	;	I1=IP
08600		MOVEM ALF
08700		SETOM PLOTIT		;	PLOTIT=-1
08800	
08900	       	MOVEI 1			;6531	M=1
09000		MOVEM PTR+=253
09100		SETOM EDX		;	EDX=-1
09200		SETZ 2,			;	DO 5532 K=1,9
09300	MP5532:	KIFIX .COMM.+4(2)	;5532	JQ(K)=RJQ(K)
09400		MOVEM .COMM.+=24(2)
09500		CAIE 2,=8
09600		AOJA 2,MP5532
09700		MOVNI 1			;	IF(PLOTIT.EQ.-1)GO TO 5121
09800		CAMN PLOTIT
09900		JRST MP5121
10000	MP590:	SETZM ALF		;590	I1=0
10100					; TO RUN THROUGH DATA.
10200		MOVE [999.0]		;	TOP=-999
10300		MOVNM DPY+1
10400		MOVEM DPY+2		;	BOT=999
10500					;GOES TO PLOTTER
10600	MP85:	MOVEI 1			;85	M=1
10700		MOVEM PTR+=253	
10800		SETZM PTR+=250		;	ITEM=0
10900		MOVEM PLTR		;8852	PLT=1
11000		SETZM EDX		;	EDX=0
11100		JRST MP6120		;	GO TO 6120
11200	
11300	MP30:	MOVE TOTAL		;30	A=TOTAL/200.0
11400		FDVR [200.0]		;	TYPE 300,A,ITMS
11500		MOVEM K#		;	CALL PLOT(0,0,99)
11600		JSA 16,ENDIT		;  THE END OF THE DATA
11700		K			;300	FORMAT(F7.2,' INCHES',I,' ITEMS')
11800		ITMS#
11900	
12000	MP60:	KIFIX 2,.COMM.		;60	J2=R2
12100		MOVEM 2,.COMM.+3
12200		CAIL 2,5			;	IF(J2.LT.5)GO TO 16
12300		JRST MP160
12400		     			;IF(J2.GT.-4)GO TO 16
12500		CAMLE 2,[-4]		;	TYPE 160,J2
12600		JRST MP16
12700	MP160:	JSA 16,ILLEGL		;	GO TO 57
12800		.COMM.+3		;160	FORMAT(' ILLEGAL STAFF# ',I4)
12900		JRST MP57
13000	MP16:	MOVE STF+3(2)		;16	RSTJ2=RSTFAC(J2)
13100		MOVEM STF+10
13200		MOVE POSI+3(2)
13300		MOVEM POSI+11		;	5541	POS=STFF(J2)
13400		MOVE .COMM.+1		;	IF(JA.NE.16)GO TO 61
13500		CAIE =16
13600		JRST MP61
13700		MOVE .COMM.+6		;	IF(R5.GE.100)R5=R5-100
13800		CAMGE [100.0]	;>100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP PARTS  
13900		JRST .+3
14000		FSBR [100.0]
14100		MOVEM .COMM.+6		; R5
14200		MOVE .COMM.+=31		;	IF(J10.NE.1)GO TO 62
14300		CAIE 1
14400		JRST MP62
14500		MOVE RWD3		;	R3=RWD3
14600		MOVEM .COMM.+4		;C  POSITIONS TEXT ITEMS.
14700	MP62:	MOVE .COMM.+6		;62	RWD3=R5*RSTJ2*R9+R3
14800		FMPR STF+10		;RSTJ2
14900		FMPR .COMM.+=10		;R9
15000		FADR .COMM.+4		;R3
15100		MOVEM RWD3
15200	MP61:	MOVE .COMM.+4		;61	RX3=R3
15300		MOVEM .COMM.+=23
15400		JSA 16,RHORZ
15500		.COMM.+4		;	J3=ROFF(RHORZ(R3))
15600		JSA 16,ROFF		;C  LINE IS DIVIDED INTO 200 POINTS.
15700		0
15800		KIFIX
15900		MOVEM .COMM.+=24	; J3
16000		JSA 16,CENTX		;	CALL CENTX
16100		FLTR .COMM.+=24	 ; SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
16200		MOVEM .COMM.+4		;	R3=J3
16300		MOVE 2,.COMM.+1		;	IF(JA.LE.2)GO TO 11
16400		CAIL 2,=19		;IF(JA.GT.18)CALL UNKNWN(JA)
16500		JRST MP5700
16600		JRST .@(2)
16700		MP11
16800		MP11
16900		MP68
17000		MP25
17100		MP67
17200	
17300		MP625		;JA=6
17400		MP116
17500		MP125
17600		MP11
17700		MP69		;JA=10
17800		
17900		MP68
18000		MP67
18100	TOTAL:	0			;JA NEVER =13,14,15
18200	RWD3:	0
18300	TOP2:	0
18400		MP116
18500		MP81		;JA=17
18600	;551	GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
18700		MP80
18800	MP80:	JSA 16,METER		;	GO TO (116,81,80),JA-15
18900		JRST MP57	;C  FOR 16,17,18 (WORDS, KSIG, METER)
19000	MP5700:	JSA 16,UNKNWN		;	TYPE 5700,JA
19100		.COMM.+1		;5700	FORMAT(' UNKNOWN CODE=',I3)
19200		JRST MP57		;	GO TO 57
19300				;TRAP FOR UNKNOWN CODE #S (SUCH AS 99-FOR "NO KSIG".
19400	
19500	MP69:	JSA 16,MAKNUM		;69	CALL MAKNUM(R5)
19600		.COMM.+6		;	GO TO 57
19700		JRST MP57
19800	MP68:	JSA 16,CLEFS		;68	CALL CLEFS
19900		JRST MP57		;	GO TO 57
20000	
20100	MP67:	JSA 16,SLUR		;67	CALL SLUR
20200		JRST MP57		;	GO TO 57
20300	
20400	MP116:	JSA 16,ALPHA		;116	CALL ALPHA
20500		JRST MP57		;	GO TO 57
20600	
20700	MP81:	JSA 16,KSIG		;81	CALL KSIG
20800		JRST MP57		;	GO TO 57
20900					;80	CALL METER
21000		         		;	GO TO 57
21100	MP125:	SKIPE .COMM.		;125	IF(R2.EQ.0)RMOV=R8
21200		JRST .+3  
21300		MOVE .COMM.+=9
21400		MOVEM RMOV#
21500		JSA 16,STAFF
21600		JRST MP57
21700	MP625:	JSA 16,BMSTF		;625	CALL BMSTF
21800					; BEAMS AND STAVES
21900		JRST MP57		;	GO TO 57
22000	
22100	MP25:	JSA 16,ITMSUB		;25	CALL ITMSUB
22200				;  BAR LINES AND SEVERAL OTHER KINDS OF LINES.
22300		JRST MP57		;	GO TO 57
22400	
22500	MP3005:	MOVN [999.0]		;3005	IF(RPLT.EQ.-999.)RPLT=R9
22600		CAME RPLT		;C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
22700		JRST .+3
22800		MOVE .COMM.+=10
22900		MOVEM RPLT
23000		MOVNI 2			;	PLOTIT=-2
23100		MOVEM PLOTIT
23800	GETEM:	JSA 16,GETFI2		;	CALL GETFI2(NAME,-1)
23900		DL+2			;C  JUMP TO READ BIG FILES
24000		[-1]
24100		JSA 16,FASTI2		;	CALL FASTI2(RSTFAC,128)
24200		STF
24300		[128]
24400		JSA 16,FASTI2		;	CALL FASTI2(PWDS,JJ2)
24500		PTR
24600		POSI+10
24700		JSA 16,FASTI2		;	CALL FASTI2(RN,IPOS)
24800		XRN
24900		POSI+11
25000		MOVE POSI+10		;	ITEM=JJ2-2
25100		SUBI 2
25200		MOVEM PTR+=250
25300		ADDM ITMS		;	ITMS=ITMS+ITEM
25400		MOVE POSI+11		;	I=IPOS
25500		MOVEM PTR+=252
25600		CAIG =2000		;2203	IF(I.LE.2000)GO TO 590
25700		JRST MP590
25800		JSA 16,TOOMCH		;	TYPE 4202,I
25900		POSI+11			;	STOP
26000				;4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
26100	MP121:	SKIPN PLOTIT		;121	IF(PLOTIT.EQ.0)GO TO 5504
26200		JRST MP5504
26300	MP5121:	JSA 16,PLTSRT		;5121	CALL PLTSRT
26400		SETOM PLTR	;IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
26500		SKIPN RPLT		;	PLT=-1
26600		JRST .+3		;	IF(RPLT.NE.0)PLT=-2
26700		MOVNI 2			;C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
26800		MOVEM PLTR
26900		SKIPE 2,.COMM.		;;	CALL NOZERO(R2)
27000		JRST .+3
27100		MOVE 2,[1.0]
27200		MOVEM 2,.COMM.
27300		FMPR 2,[1.24]		;	DIS=R2*1.24
27400		MOVEM 2,PLTR+2
27500		MOVE .COMM.+4		;	RHT=R3*1.2
27600		FMPR [1.2]		;1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
27700		MOVEM PLTR+1
27800		FMPR DPY+2		;A=BOT*RHT
27900		MOVEM A#		;??????
28000		MOVNM DPY+2		;	BOT=-A
28100		MOVE PLTR+1		;	TOTAL=TOTAL+BOT+TOP*RHT
28200		FMPR DPY+1
28300		FADR DPY+2
28400		FADRM TOTAL
28500		MOVN [999.0]		;	IF(TOP2.EQ.-999)GO TO 8121
28600		CAMN TOP2
28700		JRST MP8121
28800		MOVE 2,TOP2		;	BOT=BOT+TOP2
28900		FADRM 2,DPY+2
29000		SKIPN TOP2		;	IF(TOP2.EQ.0)BOT=0
29100		SETZM DPY+2
29200		MOVE DPY+2
29300		MOVEM A			;	A=BOT
29400		JRST MP9121		;	GO TO 9121
29500	MP8121:	SETZM RNOMOV		;8121	RNOMOV=0
29600	MP9121:	SKIPE .COMM.+=8		;9121	IF(R7.EQ.0)R7=RMOV
29700		JRST .+3		;RMOV HAS INCHES FROM P8 OF STAFF 0.
29800		MOVE RMOV
29900		MOVEM .COMM.+=8
30000		MOVE RNOMOV		;	IF(RNOMOV.GT.1)BOT=RNOMOV
30100		CAMLE [1.0]
30200		MOVEM DPY+2
30300		MOVE [200.0]		;	RNOMOV=R6+R7*200.*R3
30400		FMPR .COMM.+4
30500		FMPR .COMM.+=8
30600		FADR .COMM.+7
30700		MOVEM RNOMOV#
30800		SETZM RMOV		;	RMOV=0
30900	;  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
31000		SKIPE .COMM.+=26	;C (J4) P4=1 FOR XGP OUTPUT
31100		JRST MP6120		;	IF(J5.NE.0)GO TO 6120
31200		KIFIX DPY+2		;C  MOVES 0 POINT OVER EACH TIME.
31300		MOVEM K			;6121	CALL PLOT(0,IFIX(BOT),-3)
31400		JSA 16,PLOT		;C  MOVES PLOTTER UP IF P5=0.
31500		[0]
31600		K
31700		[-3]
31800	
31900	MP6120:	MOVE PTR+=253		;C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
32000		CAML PTR+=252		;6120	IF(M.GE.I)GO TO 7120
32100		JRST MP7120		;	CALL RUNTHR(M)
32200		JSA 16,RUNTHR		;	GO TO 60
32300		PTR+=253
32400		JRST MP60
32500	MP7120:	MOVEI 1			;7120	M=1
32600		MOVEM PTR+=253
32700		MOVE [50.0]		;71201 	A=50.*RHT
32800		FMPR PLTR+1
32900		MOVEM A
33000		MOVE PLTR+1		;	TOP=TOP*RHT
33100		FMPRM DPY+1
33200		SKIPN RNOMOV		;	IF(RNOMOV.EQ.0)GO TO 7122
33300		JRST MP7122
33400		SETZM A			;	A=0
33500	MP7121:	MOVE RNOMOV		;7121	IF(RNOMOV.LE.1)GO TO 7123
33600		CAMG [1.0]
33700		JRST MP7123
33800		MOVEM A			;	A=RNOMOV
33900		FSBR DPY+1		;	TOTAL=TOTAL+A-TOP
34000		FADRM TOTAL
34100		JRST MP7123		;	GO TO 7123
34200	MP7122:	MOVE A			;7122	TOTAL=TOTAL+A
34300		FADRM TOTAL
34400		FADR DPY+1		;	A=A+TOP
34500		MOVEM A
34600	MP7123:	KIFIX A			;7123	CALL PLOT(0,IFIX(A),3)
34700		MOVEM K
34800		JSA 16,PLOT
34900		[0]
35000		K
35100		[3]
35200		MOVE RNOMOV		;	IF(RNOMOV.EQ.1)GO TO 20
35300		CAMN [1.0]		;C  PRESERVES TOP AND BOT IF RNOMOV
35400		JRST MP20
35500		MOVE A			;	TOP=A
35600		MOVEM DPY+1
35700		MOVEM TOP2		;	TOP2=TOP
35800		JRST MP2		;	GO TO 2
35900				;  TO MOVE 'PLOTTER' FOR XGP OUTPUT
36000				;  MOVES PLOTTER UP
36100			;  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
36200	
36300		END